c  ---------------------------------------------------------------------------
c  CFL3D is a structured-grid, cell-centered, upwind-biased, Reynolds-averaged
c  Navier-Stokes (RANS) code. It can be run in parallel on multiple grid zones
c  with point-matched, patched, overset, or embedded connectivities. Both
c  multigrid and mesh sequencing are available in time-accurate or
c  steady-state modes.
c
c  Copyright 2001 United States Government as represented by the Administrator
c  of the National Aeronautics and Space Administration. All Rights Reserved.
c 
c  The CFL3D platform is licensed under the Apache License, Version 2.0 
c  (the "License"); you may not use this file except in compliance with the 
c  License. You may obtain a copy of the License at 
c  http://www.apache.org/licenses/LICENSE-2.0. 
c 
c  Unless required by applicable law or agreed to in writing, software 
c  distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 
c  WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 
c  License for the specific language governing permissions and limitations 
c  under the License.
c  ---------------------------------------------------------------------------
c
      program cfl3d_to_nmf
c
c     $Id$
c
c***********************************************************************
c     Purpose:
c     This program reads a CFL3D V6 input file and outputs a .nmf file
c     (Neutral Map File) - see http://geolab.larc.nasa.gov/Volume/Doc/nmf.htm
c     Note: currently does finest level only
c     (if want coarser levels, use v6inpdoubhalf.F to create corresponding
c     coarser input file first)
c***********************************************************************
c
      parameter(nn=20000)
c
      character*80 file1,file2
      character*80 name
      character*60 name2
      character*1 dum1
      dimension data(5)
      integer i0(nn),im(nn),j0(nn),jm(nn),k0(nn),km(nn)
      integer id(nn),jd(nn),kd(nn)
      integer nga(nn),ngb(nn),irev_a(nn),irev_b(nn)
      integer f_a(nn),s1_a(nn),e1_a(nn),s2_a(nn),e2_a(nn)
      integer f_b(nn),s1_b(nn),e1_b(nn),s2_b(nn),e2_b(nn)
c
      write(6,'('' What is input file name to read?'')')
      read(5,'(a80)') file1
      write(6,'('' What is name of neutral map file to write?'')')
      read(5,'(a80)') file2
c
      open(2,file=file1,form='formatted',status='old')
      open(3,file=file2,form='formatted',status='unknown')
c
      read(2,'(a80)') name
c   get grid name
      read(2,'(a60)') name2
      do n=1,12
        read(2,'(a60)') name2
      enddo
      read(2,'(a1)') dum1
      if (dum1 .eq. '>') then
        backspace(2)
        read(2,'(a80)') name
        do n=1,500
          read(2,'(a1)') dum1
          if (dum1 .eq. '<') goto 1002
          backspace(2)
          read(2,'(a80)') name
        enddo
        write(6,'('' Error, too many lines (>500) of keyword input'')')
        stop
 1002   continue
        backspace(2)
        read(2,'(a80)') name
      else
        backspace(2)
      end if
      read(2,'(a80)') name
      read(2,'(a80)') name
c
      read(2,*) xm,al,be,re,t,ia,ih
      read(2,'(a80)') name
      read(2,*) sr,cr,br,xm,ym,zm
      read(2,'(a80)') name
      read(2,*) dt,ir,if,fm,iu,cf
      read(2,'(a80)') name
      read(2,*) ngrid,nplot3d,nprint,nw,icc,i2d,nt,it
      if (i2d .eq. 1) ic=0
c
      read(2,'(a80)') name
      ngr=abs(ngrid)
      if(ngr .gt. nn) then
        write(6,'('' Need to increase nn to'',i5)') ngr
        stop
      end if
      do n=1,ngr
        read(2,*) nc,ie,ia,if,iv1,iv2,iv3
      enddo
c
      i2d=abs(i2d)
c
      write(3,'(''# ===== Neutral Map File generated by the V2k'',
     +  '' software of NASA Langleys GEOLAB ===== \'')')
      write(3,'(''# ==========================================='',
     +  ''======================================== \'')')
      write(3,'(''# Block#   IDIM   JDIM   KDIM \'')')
      write(3,'(''# -------------------------------------------'',
     +  ''---------------------------------------- \'')')
      write(3,'(i8,'' \'')') ngr
      write(3,'('' \'')')
c
      read(2,'(a80)') name
      do n=1,ngr
        read(2,*) id(n),jd(n),kd(n)
        write(3,'(4i7,'' \'')') n,id(n),jd(n),kd(n)
      enddo
c
      write(3,'('' \'')')
      write(3,'(''# ==========================================='',
     +  ''======================================== \'')')
      write(3,'(''# Type            B1  F1  S1   E1  S2   E2   '',
     +  ''B2  F2   S1   E1   S2  E2  Swap \'')')
      write(3,'(''# -------------------------------------------'',
     +  ''---------------------------------------- \'')')
c
      read(2,'(a80)') name
      do n=1,ngr
        read(2,*) i1,i2,i3,i4,i5,i6
      enddo
c
      read(2,'(a80)') name
      do n=1,ngr
        read(2,*) in,ig,i1,i2,i3,i4,i5,i6
      enddo
c  Idiag section:
      read(2,'(a80)') name
      do n=1,ngr
        read(2,*) i1,i2,i3,i4,i5,i6
      enddo
c  Ifds section:
      read(2,'(a80)') name
      do n=1,ngr
        read(2,*) if1,if2,if3,rk1,rk2,rk3
      enddo
c  Grid section:
      read(2,'(a80)') name
      do n=1,ngr
        read(2,*) ig,i0(n),im(n),j0(n),jm(n),k0(n),km(n),iov
        if (iov .ne. 0) then
          write(6,'('' Error. Cannot translate overset file.'')')
          stop
        end if
      enddo
c  Grid i0 section:
      read(2,'(a80)') name
      do n=1,ngr
        do m=1,i0(n)
          read(2,*) ig,is,ib,i1,i2,i3,i4,nd
          if (i1 .eq. 0) i1=1
          if (i2 .eq. 0) i2=jd(n)
          if (i3 .eq. 0) i3=1
          if (i4 .eq. 0) i4=kd(n)
          if (ib .eq. 2004) then
            write(3,'('' viscous_solid '',i5,''   3 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1005) then
            write(3,'('' tangency      '',i5,''   3 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1003) then
            write(3,'('' farfield_riem '',i5,''   3 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1002) then
            write(3,'('' farfield_extr '',i5,''   3 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1001) then
            write(3,'('' symmetry      '',i5,''   3 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 0) then
            continue
          else
            write(6,'('' BC translation not known - using CFL3D no'')')
            write(3,'(i5,10x,i5,''   3 '',4i6)') ib,ig,i1,
     +        i2,i3,i4
          end if
          if (nd .gt. 0) then
            read(2,'(a80)') name
            read(2,*) (data(mh),mh=1,nd)
          else if(nd .lt. 0) then
            read(2,'(a80)') name
            read(2,'(a80)') name
          end if
        enddo
      enddo
c  Grid idim section:
      read(2,'(a80)') name
      do n=1,ngr
        do m=1,im(n)
          read(2,*) ig,is,ib,i1,i2,i3,i4,nd
          if (i1 .eq. 0) i1=1
          if (i2 .eq. 0) i2=jd(n)
          if (i3 .eq. 0) i3=1
          if (i4 .eq. 0) i4=kd(n)
          if (ib .eq. 2004) then
            write(3,'('' viscous_solid '',i5,''   4 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1005) then
            write(3,'('' tangency      '',i5,''   4 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1003) then
            write(3,'('' farfield_riem '',i5,''   4 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1002) then
            write(3,'('' farfield_extr '',i5,''   4 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1001) then
            write(3,'('' symmetry      '',i5,''   4 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 0) then
            continue
          else
            write(6,'('' BC translation not known - using CFL3D no'')')
            write(3,'(i5,10x,i5,''   4 '',4i6)') ib,ig,i1,
     +        i2,i3,i4
          end if
          if (nd .gt. 0) then
            read(2,'(a80)') name
            read(2,*) (data(mh),mh=1,nd)
          else if(nd .lt. 0) then
            read(2,'(a80)') name
            read(2,'(a80)') name
          end if
        enddo
      enddo
c  Grid j0 section:
      read(2,'(a80)') name
      do n=1,ngr
        do m=1,j0(n)
          read(2,*) ig,is,ib,i1,i2,i3,i4,nd
          if (i1 .eq. 0) i1=1
          if (i2 .eq. 0) i2=id(n)
          if (i3 .eq. 0) i3=1
          if (i4 .eq. 0) i4=kd(n)
          if (ib .eq. 2004) then
            write(3,'('' viscous_solid '',i5,''   5 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1005) then
            write(3,'('' tangency      '',i5,''   5 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1003) then
            write(3,'('' farfield_riem '',i5,''   5 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1002) then
            write(3,'('' farfield_extr '',i5,''   5 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1001) then
            write(3,'('' symmetry      '',i5,''   5 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 0) then
            continue
          else
            write(6,'('' BC translation not known - using CFL3D no'')')
            write(3,'(i5,10x,i5,''   5 '',4i6)') ib,ig,i3,
     +        i4,i1,i2
          end if
          if (nd .gt. 0) then
            read(2,'(a80)') name
            read(2,*) (data(mh),mh=1,nd)
          else if(nd .lt. 0) then
            read(2,'(a80)') name
            read(2,'(a80)') name
          end if
        enddo
      enddo
c  Grid jdim section:
      read(2,'(a80)') name
      do n=1,ngr
        do m=1,jm(n)
          read(2,*) ig,is,ib,i1,i2,i3,i4,nd
          if (i1 .eq. 0) i1=1
          if (i2 .eq. 0) i2=id(n)
          if (i3 .eq. 0) i3=1
          if (i4 .eq. 0) i4=kd(n)
          if (ib .eq. 2004) then
            write(3,'('' viscous_solid '',i5,''   6 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1005) then
            write(3,'('' tangency      '',i5,''   6 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1003) then
            write(3,'('' farfield_riem '',i5,''   6 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1002) then
            write(3,'('' farfield_extr '',i5,''   6 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 1001) then
            write(3,'('' symmetry      '',i5,''   6 '',4i6)') ig,i3,
     +        i4,i1,i2
          else if (ib .eq. 0) then
            continue
          else
            write(6,'('' BC translation not known - using CFL3D no'')')
            write(3,'(i5,10x,i5,''   6 '',4i6)') ib,ig,i3,
     +        i4,i1,i2
          end if
          if (nd .gt. 0) then
            read(2,'(a80)') name
            read(2,*) (data(mh),mh=1,nd)
          else if(nd .lt. 0) then
            read(2,'(a80)') name
            read(2,'(a80)') name
          end if
        enddo
      enddo
c  Grid k0 section:
      read(2,'(a80)') name
      do n=1,ngr
        do m=1,k0(n)
          read(2,*) ig,is,ib,i1,i2,i3,i4,nd
          if (i1 .eq. 0) i1=1
          if (i2 .eq. 0) i2=id(n)
          if (i3 .eq. 0) i3=1
          if (i4 .eq. 0) i4=jd(n)
          if (ib .eq. 2004) then
            write(3,'('' viscous_solid '',i5,''   1 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1005) then
            write(3,'('' tangency      '',i5,''   1 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1003) then
            write(3,'('' farfield_riem '',i5,''   1 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1002) then
            write(3,'('' farfield_extr '',i5,''   1 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1001) then
            write(3,'('' symmetry      '',i5,''   1 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 0) then
            continue
          else
            write(6,'('' BC translation not known - using CFL3D no'')')
            write(3,'(i5,10x,i5,''   1 '',4i6)') ib,ig,i1,
     +        i2,i3,i4
          end if
          if (nd .gt. 0) then
            read(2,'(a80)') name
            read(2,*) (data(mh),mh=1,nd)
          else if(nd .lt. 0) then
            read(2,'(a80)') name
            read(2,'(a80)') name
          end if
        enddo
      enddo
c  Grid kdim section:
      read(2,'(a80)') name
      do n=1,ngr
        do m=1,km(n)
          read(2,*) ig,is,ib,i1,i2,i3,i4,nd
          if (i1 .eq. 0) i1=1
          if (i2 .eq. 0) i2=id(n)
          if (i3 .eq. 0) i3=1
          if (i4 .eq. 0) i4=jd(n)
          if (ib .eq. 2004) then
            write(3,'('' viscous_solid '',i5,''   2 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1005) then
            write(3,'('' tangency      '',i5,''   2 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1003) then
            write(3,'('' farfield_riem '',i5,''   2 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1002) then
            write(3,'('' farfield_extr '',i5,''   2 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 1001) then
            write(3,'('' symmetry      '',i5,''   2 '',4i6)') ig,i1,
     +        i2,i3,i4
          else if (ib .eq. 0) then
            continue
          else
            write(6,'('' BC translation not known - using CFL3D no'')')
            write(3,'(i5,10x,i5,''   2 '',4i6)') ib,ig,i1,
     +        i2,i3,i4
          end if
          if (nd .gt. 0) then
            read(2,'(a80)') name
            read(2,*) (data(mh),mh=1,nd)
          else if(nd .lt. 0) then
            read(2,'(a80)') name
            read(2,'(a80)') name
          end if
        enddo
      enddo
c  Mseq section
      read(2,'(a80)') name
      read(2,*) mseq,mg,icc,mtt,ng
c  Issc section
      read(2,'(a80)') name
      read(2,*) i1,f2,f3,f4,i5,f6,f7,f8
c  Ncyc section
      read(2,'(a80)') name
      do n=1,mseq
        read(2,*) nc,mg,ne,ni
      enddo
c  Mit section
      read(2,'(a80)') name
      do n=1,mseq
        read(2,'(a80)') name
      enddo
c  1-to-1 data
      read(2,'(a80)') name
      read(2,'(a80)') name
      read(2,*) nbli
      if (nbli .eq. 0) goto 999
      if (nbli .gt. nn) then
        write(6,'('' Error, need to increase nn'')')
        stop
      end if
c  Limits1:
      read(2,'(a80)') name
      do n=1,nbli
        read(2,*) numa,nga(n),i1a,j1a,k1a,i2a,
     +    j2a,k2a,is1a,is2a
        if (is1a.eq.1 .and. is2a.eq.2 .and. k1a.eq.1) then
          f_a(n)=1
          s1_a(n)=i1a
          e1_a(n)=i2a
          s2_a(n)=j1a
          e2_a(n)=j2a
          irev_a(n)=0
        elseif (is1a.eq.2 .and. is2a.eq.1 .and. k1a.eq.1) then
          f_a(n)=1
          s1_a(n)=i1a
          e1_a(n)=i2a
          s2_a(n)=j1a
          e2_a(n)=j2a
          irev_a(n)=1
        elseif (is1a.eq.1 .and. is2a.eq.2 .and. k1a.ne.1) then
          f_a(n)=2
          s1_a(n)=i1a
          e1_a(n)=i2a
          s2_a(n)=j1a
          e2_a(n)=j2a
          irev_a(n)=0
        elseif (is1a.eq.2 .and. is2a.eq.1 .and. k1a.ne.1) then
          f_a(n)=2
          s1_a(n)=i1a
          e1_a(n)=i2a
          s2_a(n)=j1a
          e2_a(n)=j2a
          irev_a(n)=1
c
        elseif (is1a.eq.1 .and. is2a.eq.3 .and. j1a.eq.1) then
          f_a(n)=5
          s1_a(n)=k1a
          e1_a(n)=k2a
          s2_a(n)=i1a
          e2_a(n)=i2a
          irev_a(n)=1
        elseif (is1a.eq.3 .and. is2a.eq.1 .and. j1a.eq.1) then
          f_a(n)=5
          s1_a(n)=k1a
          e1_a(n)=k2a
          s2_a(n)=i1a
          e2_a(n)=i2a
          irev_a(n)=0
        elseif (is1a.eq.1 .and. is2a.eq.3 .and. j1a.ne.1) then
          f_a(n)=6
          s1_a(n)=k1a
          e1_a(n)=k2a
          s2_a(n)=i1a
          e2_a(n)=i2a
          irev_a(n)=1
        elseif (is1a.eq.3 .and. is2a.eq.1 .and. j1a.ne.1) then
          f_a(n)=6
          s1_a(n)=k1a
          e1_a(n)=k2a
          s2_a(n)=i1a
          e2_a(n)=i2a
          irev_a(n)=0
c
        elseif (is1a.eq.2 .and. is2a.eq.3 .and. i1a.eq.1) then
          f_a(n)=3
          s1_a(n)=j1a
          e1_a(n)=j2a
          s2_a(n)=k1a
          e2_a(n)=k2a
          irev_a(n)=0
        elseif (is1a.eq.3 .and. is2a.eq.2 .and. i1a.eq.1) then
          f_a(n)=3
          s1_a(n)=j1a
          e1_a(n)=j2a
          s2_a(n)=k1a
          e2_a(n)=k2a
          irev_a(n)=1
        elseif (is1a.eq.2 .and. is2a.eq.3 .and. i1a.ne.1) then
          f_a(n)=4
          s1_a(n)=j1a
          e1_a(n)=j2a
          s2_a(n)=k1a
          e2_a(n)=k2a
          irev_a(n)=0
        elseif (is1a.eq.3 .and. is2a.eq.2 .and. i1a.ne.1) then
          f_a(n)=4
          s1_a(n)=j1a
          e1_a(n)=j2a
          s2_a(n)=k1a
          e2_a(n)=k2a
          irev_a(n)=1
        end if
      enddo
c  Limits2:
      read(2,'(a80)') name
      do n=1,nbli
        read(2,*) numb,ngb(n),i1b,j1b,k1b,i2b,
     +    j2b,k2b,is1b,is2b
        if (is1b.eq.1 .and. is2b.eq.2 .and. k1b.eq.1) then
          f_b(n)=1
          s1_b(n)=i1b
          e1_b(n)=i2b
          s2_b(n)=j1b
          e2_b(n)=j2b
          irev_b(n)=0
        elseif (is1b.eq.2 .and. is2b.eq.1 .and. k1b.eq.1) then
          f_b(n)=1
          s1_b(n)=i1b
          e1_b(n)=i2b
          s2_b(n)=j1b
          e2_b(n)=j2b
          irev_b(n)=1
        elseif (is1b.eq.1 .and. is2b.eq.2 .and. k1b.ne.1) then
          f_b(n)=2
          s1_b(n)=i1b
          e1_b(n)=i2b
          s2_b(n)=j1b
          e2_b(n)=j2b
          irev_b(n)=0
        elseif (is1b.eq.2 .and. is2b.eq.1 .and. k1b.ne.1) then
          f_b(n)=2
          s1_b(n)=i1b
          e1_b(n)=i2b
          s2_b(n)=j1b
          e2_b(n)=j2b
          irev_b(n)=1
c
        elseif (is1b.eq.1 .and. is2b.eq.3 .and. j1b.eq.1) then
          f_b(n)=5
          s1_b(n)=k1b
          e1_b(n)=k2b
          s2_b(n)=i1b
          e2_b(n)=i2b
          irev_b(n)=1
        elseif (is1b.eq.3 .and. is2b.eq.1 .and. j1b.eq.1) then
          f_b(n)=5
          s1_b(n)=k1b
          e1_b(n)=k2b
          s2_b(n)=i1b
          e2_b(n)=i2b
          irev_b(n)=0
        elseif (is1b.eq.1 .and. is2b.eq.3 .and. j1b.ne.1) then
          f_b(n)=6
          s1_b(n)=k1b
          e1_b(n)=k2b
          s2_b(n)=i1b
          e2_b(n)=i2b
          irev_b(n)=1
        elseif (is1b.eq.3 .and. is2b.eq.1 .and. j1b.ne.1) then
          f_b(n)=6
          s1_b(n)=k1b
          e1_b(n)=k2b
          s2_b(n)=i1b
          e2_b(n)=i2b
          irev_b(n)=0
c
        elseif (is1b.eq.2 .and. is2b.eq.3 .and. i1b.eq.1) then
          f_b(n)=3
          s1_b(n)=j1b
          e1_b(n)=j2b
          s2_b(n)=k1b
          e2_b(n)=k2b
          irev_b(n)=0
        elseif (is1b.eq.3 .and. is2b.eq.2 .and. i1b.eq.1) then
          f_b(n)=3
          s1_b(n)=j1b
          e1_b(n)=j2b
          s2_b(n)=k1b
          e2_b(n)=k2b
          irev_b(n)=1
        elseif (is1b.eq.2 .and. is2b.eq.3 .and. i1b.ne.1) then
          f_b(n)=4
          s1_b(n)=j1b
          e1_b(n)=j2b
          s2_b(n)=k1b
          e2_b(n)=k2b
          irev_b(n)=0
        elseif (is1b.eq.3 .and. is2b.eq.2 .and. i1b.ne.1) then
          f_b(n)=4
          s1_b(n)=j1b
          e1_b(n)=j2b
          s2_b(n)=k1b
          e2_b(n)=k2b
          irev_b(n)=1
        end if
        if (irev_a(n) .eq. irev_b(n)) then
          write(3,'('' one-to-one  '',12i5,'' false \'')') 
     +      nga(n),f_a(n),s1_a(n),e1_a(n),s2_a(n),e2_a(n),
     +      ngb(n),f_b(n),s1_b(n),e1_b(n),s2_b(n),e2_b(n)
        else
          write(3,'('' one-to-one  '',12i5,'' true \'')')
     +      nga(n),f_a(n),s1_a(n),e1_a(n),s2_a(n),e2_a(n),
     +      ngb(n),f_b(n),s1_b(n),e1_b(n),s2_b(n),e2_b(n)
        end if
      enddo
c  Patch:
      read(2,'(a80)') name
      read(2,'(a80)') name
      read(2,*) ninter
      if (ninter .lt. 0) then
        write(6,'('' Error. Cannot translate patch file'')')
        stop
      end if
c
 999  continue
      write(6,'(/,'' new .nmf file successfully output'',
     + '' to '',a80)') file2
      write(6,'(''WARNING: check .nmf file for BC names!  Be'',
     + '' sure they are appropriate for'')')
      write(6,'(''  your application (e.g., this code uses a'',
     + '' BC name symmetry... some aps may need specific'')')
      write(6,'(''  symmetry_y or symmetry_y_strong, for example)'')')
      stop
      end
